home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / mule / mule-keyboard.el.z / mule-keyboard.el
Encoding:
Text File  |  1998-05-21  |  14.6 KB  |  428 lines
  1. ;;; mule-keyboard.el --- Direct input of multilingual chars from keyboard.
  2.  
  3. ;; Copyright (C) 1992 Free Software Foundation, Inc.
  4.  
  5. ;; This file is part of XEmacs.
  6.  
  7. ;; XEmacs is free software; you can redistribute it and/or modify it
  8. ;; under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation; either version 2, or (at your option)
  10. ;; any later version.
  11.  
  12. ;; XEmacs is distributed in the hope that it will be useful, but
  13. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. ;; General Public License for more details.
  16.  
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with XEmacs; see the file COPYING.  If not, write to the 
  19. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20. ;; Boston, MA 02111-1307, USA.
  21.  
  22. ;;; 92.3.5   created for Mule Ver.0.9.0 by K.Handa <handa@etl.go.jp>
  23.  
  24. ;;;###autoload
  25. (defvar keyboard-allow-latin-input nil
  26.   "If non-nil, \"ESC , Fe\" and \"ESC - Fe\" are used for inputting
  27. Latin characters.")
  28.  
  29. ;; common global variables of internal use
  30. (defvar _keyboard-first-byte_ nil
  31.   "Character buffer for the first byte of two-byte character.")
  32. (defvar _keyboard-SS2_ nil
  33.   "Flag to indicate Single Shift SS2.")
  34. (defvar _keyboard-SS3_ nil
  35.   "Flag to indicate Single Shift SS3.")
  36. (defvar _keyboard-saved-local-map_ nil
  37.   "Saved local keymap.")
  38. (defvar _saved-local-map-single-shift_ nil
  39.   "Saved single shift local map.")
  40.  
  41. (defvar _current-g0_ 0)
  42. (defvar _current-g1_ nil)
  43. (defvar _current-g2_ nil)
  44. (defvar _current-g3_ nil)
  45.  
  46. (defconst local-map-iso nil
  47.   "Local keymap used while inputing ISO2022 code directly.")
  48. (defconst local-map-shift-jis nil
  49.   "Local keymap used while inputing Shift-JIS code directly.")
  50. (defconst local-map-big5 nil
  51.   "Local keymap used while inputing Big5 code directly.")
  52.  
  53. (defconst esc-dol-map nil "Keys to designate 94n or 96n charset.")
  54. (defconst esc-openpar-map nil "Keys to designate 94 charset to GL.")
  55. (defconst esc-closepar-map nil "Keys to designate 94 charset to GR.")
  56. (defconst esc-comma-map nil "Keys to designate 96 charset to GL.")
  57. (defconst esc-minus-map nil "Keys to designate 96 charset to GR.")
  58. (defconst esc-dol-openpar-map nil "Keys to designate 94n charset to GL.")
  59. (defconst esc-dol-closepar-map nil "Keys to designate 94n charset to GR.")
  60. (defconst esc-dol-comma-map nil "Keys to designate 96n charset to GL.")
  61. (defconst esc-dol-minus-map nil "Keys to designate 96n charset to GR.")
  62.  
  63. ;;;###autoload
  64. (defun set-keyboard-coding-system (codesys)
  65.   "Set variable keyboard-coding-system to CODESYS and modify keymap for it."
  66.   (interactive "zKeyboard-coding-system: ")
  67.   (let ((type (coding-system-type codesys)))
  68.     (cond ((eq type 'shift-jis)
  69.        (set-keyboard-coding-system-shift-jis))
  70.       ((eq type 'iso2022)
  71.        (set-keyboard-coding-system-iso2022 codesys))
  72.       ((eq type 'big5)
  73.        (set-keyboard-coding-system-big5))
  74.       (t
  75.        (error "Direct input of code %s is not supported." codesys)))))
  76.  
  77. (defsubst keyboard-define-key (map key command)
  78.   (define-key map (char-to-string key) command t))
  79.  
  80. (defun keyboard-set-input-mode (value)
  81.   (let ((mode (current-input-mode)))
  82.     ;; current-input-mode returns (INTERRUPT FLOW META QUIT-CHAR)
  83.     ;; set META to value.
  84.     (setcar (nthcdr 2 mode) value)
  85.     (apply (function set-input-mode) mode)))
  86.  
  87.  
  88. (defun keyboard-select-keymap (&rest maps)
  89.   (or (nth (get-code-type keyboard-coding-system) maps)
  90.       (error "invalid keyboard-coding-system")))
  91.  
  92. (defun keyboard-self-insert-do-insert (char)
  93.   (self-insert-internal char)
  94.   (check-auto-fill))
  95.  
  96. ;; ### I think this is the right function to put this on... must check further
  97. ;; wire us into pending-delete
  98. (put 'keyboard-self-insert-do-insert 'pending-delete t)
  99.  
  100. (defun keyboard-use-local-map-do-insert (map)
  101.   (use-local-map map))
  102.  
  103. (defun keyboard-current-local-map-do-insert ()
  104.   (current-local-map))
  105.  
  106. (defun keyboard-local-map-do-insert ()
  107.   (keyboard-select-keymap nil local-map-shift-jis local-map-iso local-map-big5))
  108.  
  109.  
  110. (defconst keyboard-self-insert-function 
  111.   (function keyboard-self-insert-do-insert))
  112.  
  113. (defconst keyboard-use-local-map-function 
  114.   (function keyboard-use-local-map-do-insert))
  115.  
  116. (defconst keyboard-current-local-map-function 
  117.   (function keyboard-current-local-map-do-insert))
  118.  
  119. (defconst keyboard-local-map-function 
  120.   (function keyboard-local-map-do-insert))
  121.  
  122. (defun keyboard-self-insert (char)
  123.   (funcall keyboard-self-insert-function char))
  124.  
  125. (defun keyboard-current-local-map ()
  126.   (funcall keyboard-current-local-map-function))
  127.  
  128. (defun keyboard-use-local-map (map)
  129.   (funcall keyboard-use-local-map-function map))
  130.  
  131. (defun keyboard-local-map ()
  132.   (funcall keyboard-local-map-function))
  133.  
  134.  
  135. (defun keyboard-reset-state ()
  136.   (setq _keyboard-first-byte_ nil
  137.     _keyboard-SS2_ nil
  138.     _keyboard-SS3_ nil))
  139.  
  140. (defun keyboard-define-global-map-iso (map)
  141.   (let ((i 160))
  142.     (while (< i 256)
  143.       (keyboard-define-key map i 'self-insert-iso)
  144.       (setq i (1+ i))))
  145.   (define-key map "\216" 'keyboard-SS2 t)
  146.   (define-key map "\217" 'keyboard-SS3 t)
  147.   (define-key map "\e(" 'esc-openpar-prefix)
  148.   (define-key map "\e)" 'esc-closepar-prefix)
  149.   (if keyboard-allow-latin-input
  150.       (progn
  151.     (define-key map "\e," 'esc-comma-prefix)
  152.     (define-key map "\e-" 'esc-minus-prefix)))
  153.   (define-key map "\e$" 'esc-dol-prefix))
  154.  
  155. (defun keyboard-define-local-map-iso (map)
  156.   (let ((i 33))
  157.     (while (< i 127)
  158.       (keyboard-define-key map i 'self-insert-iso)
  159.       (setq i (1+ i)))))
  160.  
  161. (defun set-keyboard-coding-system-iso2022 (code)
  162.   (setq _current-g0_ (coding-system-charset code 0))
  163.   (setq _current-g1_ (coding-system-charset code 1))
  164.   (setq _current-g2_ (coding-system-charset code 2))
  165.   (setq _current-g3_ (coding-system-charset code 3))
  166.   (if (null _current-g1_)
  167.       (keyboard-set-input-mode t)    ; enable Meta-key
  168.     (keyboard-set-input-mode 0))    ; enable 8bit input as chars.
  169.   (let (i)
  170.     (setq i 160)
  171.     (while (< i 256)
  172.       (keyboard-define-key global-map i 'self-insert-iso)
  173.       (setq i (1+ i))))
  174.   (if local-map-iso nil
  175.     (setq local-map-iso (make-keymap))
  176.     (let (i map)
  177.       (setq i 33)
  178.       (while (< i 127)
  179.     (keyboard-define-key local-map-iso i 'self-insert-iso)
  180.     (setq i (1+ i)))
  181.       (setq map (current-global-map))
  182.       (setq i 161)
  183.       (while (< i 255)
  184.     (keyboard-define-key map i 'self-insert-iso)
  185.     (setq i (1+ i))))
  186.     (define-key local-map-iso "\C-g" 'mule-keyboard-quit))
  187.   (if esc-dol-map nil
  188.     (setq esc-dol-map (make-keymap)
  189.       esc-openpar-map (make-keymap)
  190.       esc-closepar-map (make-keymap)
  191.       esc-comma-map (make-keymap)
  192.       esc-minus-map (make-keymap)
  193.       esc-dol-openpar-map (make-keymap)
  194.       esc-dol-closepar-map (make-keymap)
  195.       esc-dol-comma-map (make-keymap)
  196.       esc-dol-minus-map (make-keymap))
  197.     (fset 'esc-dol-prefix esc-dol-map)
  198.     (fset 'esc-openpar-prefix esc-openpar-map)
  199.     (fset 'esc-closepar-prefix esc-closepar-map)
  200.     (fset 'esc-comma-prefix esc-comma-map)
  201.     (fset 'esc-minus-prefix esc-minus-map)
  202.     (fset 'esc-dol-openpar-prefix esc-dol-openpar-map)
  203.     (fset 'esc-dol-closepar-prefix esc-dol-closepar-map)
  204.     (fset 'esc-dol-comma-prefix esc-dol-comma-map)
  205.     (fset 'esc-dol-minus-prefix esc-dol-minus-map)
  206.     (define-key esc-dol-map "(" 'esc-dol-openpar-prefix)
  207.     (define-key esc-dol-map ")" 'esc-dol-closepar-prefix)
  208.     (define-key esc-dol-map "," 'esc-dol-comma-prefix)
  209.     (define-key esc-dol-map "-" 'esc-dol-minus-prefix)
  210.     (let (i)
  211.       (setq i ?0)
  212.       (while (< i ?`)
  213.     (keyboard-define-key esc-openpar-map i 'keyboard-designate-94-GL)
  214.     (keyboard-define-key esc-closepar-map i 'keyboard-designate-94-GR)
  215.     (keyboard-define-key esc-comma-map i 'keyboard-designate-96-GL)
  216.     (keyboard-define-key esc-minus-map i 'keyboard-designate-96-GR)
  217.     (keyboard-define-key esc-dol-map i 'keyboard-designate-94n-GL)
  218.     (keyboard-define-key esc-dol-openpar-map i 'keyboard-designate-94n-GL)
  219.     (keyboard-define-key esc-dol-closepar-map i 'keyboard-designate-94n-GR)
  220.     (keyboard-define-key esc-dol-comma-map i 'keyboard-designate-96n-GL)
  221.     (keyboard-define-key esc-dol-minus-map i 'keyboard-designate-96n-GR)
  222.     (setq i (1+ i)))))
  223.   (define-key global-map "\216" 'keyboard-SS2 t)
  224.   (define-key global-map "\217" 'keyboard-SS3 t)
  225.   (define-key esc-map "(" 'esc-openpar-prefix)
  226.   (define-key esc-map ")" 'esc-closepar-prefix)
  227.   (if keyboard-allow-latin-input
  228.       (progn
  229.     (define-key esc-map "," 'esc-comma-prefix)
  230.     (define-key esc-map "-" 'esc-minus-prefix)))
  231.   (define-key esc-map "$" 'esc-dol-prefix)
  232.   (keyboard-reset-state)
  233.   (setq keyboard-coding-system code)
  234.   )
  235.  
  236. (defun mule-keyboard-quit ()
  237.   (interactive)
  238.   (keyboard-reset-state)
  239.   (if _keyboard-saved-local-map_
  240.       (keyboard-use-local-map _keyboard-saved-local-map_))
  241.   (keyboard-quit))
  242.  
  243. (defun keyboard-change-local-map-for-iso ()
  244.   (if (eq (keyboard-current-local-map) (keyboard-local-map))
  245.       nil
  246.     (setq _keyboard-saved-local-map_ (keyboard-current-local-map))
  247.     (keyboard-use-local-map (keyboard-local-map))))
  248.  
  249. (defun keyboard-designate-94-GL ()
  250.   (interactive)
  251.   (if (and (coding-system-use-japanese-jisx0201-roman keyboard-coding-system)
  252.        (eq 'japanese-jisx0201-roman
  253.            (charset-from-attributes 1 94 last-command-char)))
  254.       (setq _current-g0_ 'ascii)
  255.     (setq _current-g0_ (charset-from-attributes 1 94 last-command-char)))
  256.   (if (eq _current-g0_ 'ascii)
  257.       (keyboard-use-local-map _keyboard-saved-local-map_)
  258.     (keyboard-change-local-map-for-iso)))
  259.  
  260. (defun keyboard-designate-94-GR ()
  261.   (interactive)
  262.   (setq _current-g1_ (charset-from-attributes 1 94 last-command-char)))
  263.  
  264. (defun keyboard-designate-96-GL ()
  265.   (interactive)
  266.   (setq _current-g0_ (charset-from-attributes 1 96 last-command-char))
  267.   (keyboard-change-local-map-for-iso))
  268.  
  269. (defun keyboard-designate-96-GR ()
  270.   (interactive)
  271.   (setq _current-g1_ (charset-from-attributes 1 96 last-command-char)))
  272.  
  273. (defun keyboard-designate-94n-GL ()
  274.   (interactive)
  275.   (if (and (coding-system-use-japanese-jisx0208-1978 keyboard-coding-system)
  276.        (eq 'japanese-jisx0208-1978
  277.            (charset-from-attributes 2 94 last-command-char)))
  278.       (setq _current-g0_ 'japanese-jisx0208)
  279.     (setq _current-g0_ (charset-from-attributes 2 94 last-command-char)))
  280.   (keyboard-change-local-map-for-iso))
  281.  
  282. (defun keyboard-designate-94n-GR ()
  283.   (interactive)
  284.   (setq _current-g1_ (charset-from-attributes 2 94 last-command-char)))
  285.  
  286. (defun keyboard-designate-96n-GL ()
  287.   (interactive)
  288.   (setq _current-g0_ (charset-from-attributes 2 96 last-command-char))
  289.   (keyboard-change-local-map-for-iso))
  290.  
  291. (defun keyboard-designate-96n-GR ()
  292.   (interactive)
  293.   (setq _current-g1_ (charset-from-attributes 2 96 last-command-char)))
  294.  
  295. (defun keyboard-SS2 ()
  296.   (interactive)
  297.   (setq _keyboard-SS2_ t)
  298.   (setq _saved-local-map-single-shift_ (keyboard-current-local-map))
  299.   (keyboard-change-local-map-for-iso))
  300.  
  301. (defun keyboard-SS3 ()
  302.   (interactive)
  303.   (setq _keyboard-SS3_ t)
  304.   (setq _saved-local-map-single-shift_ (keyboard-current-local-map))
  305.   (keyboard-change-local-map-for-iso))
  306.  
  307. (defun self-insert-iso ()
  308.   (interactive)
  309.   (let ((charset (cond (_keyboard-SS2_ _current-g2_)
  310.                (_keyboard-SS3_ _current-g3_)
  311.                ((< last-command-char 128) _current-g0_)
  312.                (t _current-g1_))))
  313.     (if (not charset) (mule-keyboard-quit))
  314.     (if (= (charset-dimension charset) 1)
  315.     (progn
  316.       (keyboard-self-insert (make-char charset last-command-char))
  317.       (if (or _keyboard-SS2_ _keyboard-SS3_)
  318.           (keyboard-use-local-map _saved-local-map-single-shift_))
  319.       (keyboard-reset-state))
  320.       (if _keyboard-first-byte_
  321.       (progn
  322.         (keyboard-self-insert (make-char charset _keyboard-first-byte_
  323.                          last-command-char))
  324.         (if (or _keyboard-SS2_ _keyboard-SS3_)
  325.         (keyboard-use-local-map _saved-local-map-single-shift_))
  326.         (keyboard-reset-state))
  327.     (setq _keyboard-first-byte_ last-command-char)))))
  328.  
  329.  
  330. (defun keyboard-define-global-map-shift-jis (map)
  331.   (let ((i 128))
  332.     (while (< i 160)
  333.       (keyboard-define-key map i 'self-insert-shift-jis-japanese)
  334.       (setq i (1+ i)))
  335.     (while (< i 224)
  336.       (keyboard-define-key map i 'self-insert-shift-jis-kana)
  337.       (setq i (1+ i)))
  338.     (while (< i 256)
  339.       (keyboard-define-key map i 'self-insert-shift-jis-japanese)
  340.       (setq i (1+ i)))))
  341.  
  342. (defun keyboard-define-local-map-shift-jis (map)
  343.   (let ((i 64))
  344.     (while (< i 256)
  345.       (keyboard-define-key map i 'self-insert-shift-jis-japanese2)
  346.       (setq i (1+ i)))))
  347.  
  348. (defun set-keyboard-coding-system-shift-jis ()
  349.   (keyboard-set-input-mode 0)        ; enable 8bit input as chars
  350.   (keyboard-define-global-map-shift-jis global-map)
  351.   (if local-map-shift-jis 
  352.       nil
  353.     (setq local-map-shift-jis (make-keymap))
  354.     (keyboard-define-local-map-shift-jis local-map-shift-jis)
  355.     (define-key local-map-shift-jis "\C-g" 'mule-keyboard-quit))
  356.   (setq _keyboard-first-byte_ nil)
  357.   (setq keyboard-coding-system 'shift-jis))
  358.  
  359. (defun self-insert-shift-jis-japanese ()
  360.   (interactive)
  361.   (setq _keyboard-first-byte_ last-command-char)
  362.   (setq _keyboard-saved-local-map_ (keyboard-current-local-map))
  363.   (keyboard-use-local-map (keyboard-local-map)))
  364.  
  365. (defun self-insert-shift-jis-japanese2 ()
  366.   (interactive)
  367.   (if _keyboard-first-byte_
  368.       (let ((char
  369.          (decode-shift-jis-char _keyboard-first-byte_ last-command-char)))
  370.     (keyboard-self-insert char)
  371.     (setq _keyboard-first-byte_ nil)))
  372.   (keyboard-use-local-map _keyboard-saved-local-map_))
  373.  
  374. (defun self-insert-shift-jis-kana ()
  375.   (interactive)
  376.   (keyboard-self-insert (make-char 'japanese-jisx0201-kana last-command-char)))
  377.  
  378.  
  379. (defun keyboard-define-global-map-big5 (map)
  380.   (let ((i ?\xA1))
  381.     (while (< i ?\xFE)
  382.       (keyboard-define-key map i 'self-insert-big5-1)
  383.       (setq i (1+ i)))))
  384.  
  385. (defun keyboard-define-local-map-big5 (map)
  386.   (let ((i ?\x40))
  387.     (while (< i ?\x7F)
  388.       (keyboard-define-key map i 'self-insert-big5-2)
  389.       (setq i (1+ i)))
  390.     (setq i ?\xA1)
  391.     (while (< i ?\xFF)
  392.       (keyboard-define-key map i 'self-insert-big5-2)
  393.       (setq i (1+ i)))
  394.     ))
  395.  
  396. (defun set-keyboard-coding-system-big5 ()
  397.   (require 'chinese)
  398.   (keyboard-set-input-mode 0)        ; enable 8bit input as chars
  399.   (keyboard-define-global-map-big5 global-map)
  400.   (if local-map-big5
  401.       nil
  402.     (setq local-map-big5 (make-keymap))
  403.     (keyboard-define-local-map-big5 local-map-big5)
  404.     (define-key local-map-big5 "\C-g" 'mule-keyboard-quit))
  405.   (setq _keyboard-first-byte_ 0)
  406.   (setq keyboard-coding-system 'big5))
  407.  
  408. (defun self-insert-big5-1 ()
  409.   (interactive)
  410.   (setq _keyboard-first-byte_ last-command-char)
  411.   (setq _keyboard-saved-local-map_ (keyboard-current-local-map))
  412.   (keyboard-use-local-map (keyboard-local-map)))
  413.  
  414. (defun self-insert-big5-2 ()
  415.   (interactive)
  416.   (if _keyboard-first-byte_
  417.       (progn
  418.     (keyboard-self-insert
  419.      (decode-big5-char _keyboard-first-byte_ last-command-char
  420.                'character))
  421.     (setq _keyboard-first-byte_ nil)))
  422.   (keyboard-use-local-map _keyboard-saved-local-map_))
  423.  
  424.  
  425. (defun check-auto-fill ()
  426.   (if (and auto-fill-function (> (current-column) fill-column))
  427.       (funcall auto-fill-function)))
  428.